; Find scheme procedures whose name includes a given string.
; example, 
;----------------------------------------------------------------------
;         ((if (substring? what (symbol->string (car l)))
;            (got-one (car l))
;(display "yes A\n")
(define strsubtract (lambda (str1 str2)
                       (define strlen1 (string-length str1))
                       (define strlen2 (string-length str2))
                       (define str3 "")
                       (if (and (substring? str1 str2)(and (> strlen2 strlen1) (> strlen1 0)))
                          (do ((i strlen2 (- i 1)))((or (<= i 0)(> (string-length str3) 0)))
                            (if (not(substring? str1 (substring str2 0 i)))
                              (if (< i (- strlen2 1))
                                  (set! str3 (substring str2 (+ i 1) strlen2))(set! str3 "")
                              )
                            )
                          )
                       )
                       str3
                    )
)
(define headsubstring? (lambda (str2 str1)
                         (if (and (> (string-length str2) 0)(>= (string-length str1) (string-length str2)))
                         (string=? str2 (substring str1 0 (string-length str2)))
                         #f)
                      )
)
(define tailsubstring? (lambda (str2 str1)
                         (if (and (> (string-length str2) 0)(>= (string-length str1) (string-length str2)))
                              (string=? str2 (substring str1 (-(string-length str1)(string-length str2)) (string-length str1))) #f)
                      )
)
;(display "yes A1\n")
(define allsubstr? (lambda (str strvec nstring) 
                      (define tmpstr)
                      (define ret #t)
                      (if (<= nstring (vector-length strvec))
                      (begin(define tmpsymstr str)
                      (do ((i 0 (+ 1 i)))((>= i nstring))
                         (begin(set! tmpstr (vector-ref strvec i))
                         (if ( > (string-length tmpstr) 0)
                            (if (not (substring? tmpstr  tmpsymstr))
                               (set! ret #f)(set! tmpsymstr (strsubtract  tmpstr tmpsymstr))
                         ))
                              
                       )
                      ))(set! ret #f))
                      ret
                   )
)
(define help)

(let ((found))
    (define (got-one sym)
        (if (bound? sym)
            (begin
                (set! found #t)
                (print sym))))

(set! help (lambda (what)
  (if (symbol? what)
      (set! what (symbol->string what))
      (if (not (string? what))
          (error 'help "string or symbol expected")))
  (define star #\*)
  (define fstar)
  (define mstar)
  (define lstar)
  (define fmlstar)
  (define fmstar)
  (define flstar)
  (define ofstar)
  (define mlstar)
  (define omstar)
  (define olstar)
  (define nostar)
  (if (char=? star  (string-ref what 0)) (set! fstar #t) (set! fstar #f))
  (define last (- (string-length what) 1))
  (if (char=? star  (string-ref what last)) (set! lstar #t) (set! lstar #f))
  (define whatcut (substring what 1  (string-length what)))
  (define whatmid  (substring whatcut 0  (- (string-length whatcut) 1)))
  (if (substring? "*" whatmid)(set! mstar #t)(set! mstar #f))
  (if (and (and fstar mstar) lstar) (set! fmlstar #t)(set! fmlstar #f))
  (if (and (and fstar mstar) (not lstar)) (set! fmstar #t)(set! fmstar #f))
  (if (and (and fstar (not mstar)) lstar) (set! flstar #t)(set! flstar #f))
  (if (and (and fstar (not mstar)) (not lstar)) (set! ofstar #t)(set! ofstar #f))
  (if (and (and (not fstar) mstar) lstar) (set! mlstar #t)(set! mlstar #f))
  (if (and (and (not fstar) mstar) (not lstar)) (set! omstar #t)(set! omstar #f))
  (if (and (and (not fstar) (not mstar)) lstar) (set! olstar #t)(set! olstar #f))
  (if (and (and (not fstar) (not mstar)) (not lstar)) (set! nostar #t)(set! nostar #f))
  (if fstar (set! what whatcut))
  (if lstar (set! what (substring what 0 (- (string-length what) 1))))
  (define bcharpos 0)
  (define n 0)
  (define nstring 0)
  (define symstr)
  (define tmpstr)
  (define symstr)
  (define symlen)
  (define whatlen (string-length what))
  (define strvec (make-vector 10))
;(display "yes B\n")
  (if mstar (begin(define l (string->list what)) 
           (do ((strtail l  (cdr strtail))) ((null? strtail))
                (begin(if (or (char=? star (car strtail))(null? (cdr strtail))) 
                      (begin(if (not (char=? star (car strtail))) (set! n (+ 1 n)))
                            (if (> n bcharpos)(begin(vector-set! strvec nstring (substring what bcharpos n))
                       (set! nstring (+ 1 nstring))))
                       (set! bcharpos  (+ 1 n))))
                (set! n (+ 1 n))))
  ))
;(display "\n")  
;(display (vector-ref strvec 0) )
;(display "\n")  
;(display (vector-ref strvec 1) )
;(display "\n")  
;(display "yes C\n")
;(display what)
;(display "\n")  
  (set! found #f)
  (do ((tail (oblist) (cdr tail))) ((null? tail))
    (do ((l (car tail) (cdr l))) ((null? l))
      (begin(set! symstr (symbol->string (car l)))
       (set! symlen (string-length symstr))
       (set! tmpstr (string-copy symstr))
       (if nostar
         (if (string=? what symstr)
            (got-one (car l))
         )
       (if ofstar
         (if (tailsubstring? what symstr)
            (got-one (car l)))
         (if (and olstar (> symlen whatlen))
           (if (headsubstring? what symstr)
            (got-one (car l)))
          (if omstar(if (and (and (headsubstring? (vector-ref strvec 0)symstr)(tailsubstring? (vector-ref strvec (- nstring 1))symstr)) (allsubstr? symstr strvec nstring))(got-one (car l)))
             (if fmlstar (if (allsubstr? symstr strvec nstring)(got-one (car l)))
              (if flstar (if (substring? what symstr)(got-one (car l))) 
                  (if fmstar (if (and (tailsubstring? (vector-ref strvec (- nstring 1)) symstr)(allsubstr? symstr strvec nstring))(got-one (car l))) 
                      (if mlstar (if (and (headsubstring? (vector-ref strvec 0) symstr)(allsubstr? symstr strvec nstring))(got-one (car l))) )
                  )
              ) 
             )
            )
           )
        )
       )
      )
    )
  )
;(display "yes D\n")
  (if (not found)
      (format #t "~a: nothing appropriate~%" what))
  #v)))

